perm filename TYPESE.SAI[P,JRA] blob
sn#322652 filedate 1977-12-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00028 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 DEFINE CRLF="('15&'12)", !="comment", proc="simple procedure",
C00011 00003 ! define punch(x)=⊂wordout(ptpchan,x)⊃
C00012 00004 boolean procedure defile(integer chan string file,ext,pj,pn) begin ! file defaults
C00013 00005 proc cw_init(string sinteger n)
C00014 00006 proc cw_print(string sinteger n)
C00016 00007 ! procedure typeset(string s)
C00018 00008 proc punch_num(string s)
C00019 00009 proc tab_set(integer n)
C00021 00010 define
C00023 00011 ! character width stuff
C00024 00012 proc stuff(integer x) ! x is tty code, jam it in punch buffer
C00025 00013 procedure film_adv(string s) ! s is string rep of point, half-point advance
C00026 00014 procedure line_meas(integer n) ! n is pixel width of page. punch it
C00027 00015 proc indentto(integer n) ! manufacture the "bellIL" sequence
C00028 00016 proc tab_to(integer n) ! manufacture the guts of the bell X-Y
C00029 00017 ! proc setfont(integer n)
C00031 00018 ! proc setfootfont(integer n)
C00033 00019 ! proc burp( reference integer array p: integer sup1, sub1, text)
C00035 00020 ! proc punch_sum(string s)
C00036 00021 ! procedure setline ! end of line routine. must check for sup/sub hacking
C00039 00022 ! procedure setfootline ! end of line routine. must check for sup/sub hacking
C00042 00023 ! proc linesp(integer n)
C00043 00024 procedure set_foot
C00047 00025 begin "MAIN PROGRAM"
C00050 00026 add crap for page number location (suck for "<FF>")
C00051 00027 read page 1
C00054 00028 outstr("end of fonts")
C00059 ENDMK
C⊗;
DEFINE CRLF="('15&'12)", !="comment", proc="simple procedure",
crlfff="('15&'12&'14)",
crlfffsp="('15&'12&'14&'40)",
INCHAN=1,PTPCHAN=2,fontchan=3;
BEGIN "TYPESET"
require"⊂⊃⊂⊃"delimiters;
string s,s1,slead,swidth,ext;
integer lead,lmar,xline,width,pwidth,i,eof,pagebeg,pagend;
integer page,tolb,torb,tospeq,offset; ! offset is running left margin;
integer todot,tocolon;
boolean foo; ! the punch debug flag;
define debug(x)=⊂⊃;
! define debug(x)=⊂outstr(x)⊃;
PRELOAD_with
"Feed",
" th_sp ",
"e",
"3",
" ELEV",
"feed",
"a",
"$",
comment 10;
" ",
" adth ",
"s",
" emsp ",
"i",
"8",
"u",
"7",
comment 20;
"ret",
"'",
"d",
"-",
"r",
"4",
"j",
"BELL",
comment 30;
"n",
",",
"f",
" QL",
"c",
" ENSP ",
"k",
" QR",
comment 40;
"t",
"5",
"z",
")",
"l",
"SS",
"w",
"2",
comment 50;
"h",
" EML ",
"y",
"6",
"p",
"0",
"q",
" ENL ",
comment 60;
"o",
"9",
"b",
" URL ",
"g",
";",
"↑",
"LRL",
comment 70;
"m",
".",
"x",
"1",
"v",
" QC ",
"↓",
"RUB";string array vip[0:64];
PRELOAD_with
"a1","a5","b1","a1","c6","b1","a3","a1","a3","b6","a3","a4","a4","b5","a3","a3";
string array font[0:16];
PRELOAD_with
"10","10","10","07","10","10","10","07","10","24","10","08","10","10","10","10";
string array fontsize[0:16]; ! an extra slot for vip specials;
PRELOAD_with
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
'15, 0, 0, 0, 0, 0, 0, 0,
0, '07, 0, 0, -'07, '23, '61, -'21,
'43, -'43, 0, 0, -'31, -'23, -'71, 0,
-'55, -'73, -'47, -'03, -'25, -'41, -'53, -'17,
-'15, -'61, '65, -'65, 0, 0, 0, '55,
0, '06, '62, '34, '22, '02, '32, '64,
'50, '14, '26, '36, '44, '70, '30, '60,
'54, '56, '24, '12, '40, '16, '74, '46,
'72, '52, '42, 0, 0, 0, 0, 0,
'21, -'06, -'62, -'34, -'22, -'02, -'32, -'64,
-'50, -'14, -'26, -'36, -'44, -'70, -'30, -'60,
-'54, -'56, -'24, -'12, -'40, -'16, -'74, -'46,
-'72, -'52, -'42, 0, 0, 0, 0, 0;
integer array chrtbl[0:128]; ! table encoding p-45 vip codes;
! table is indexed by ascii code;
! if entry is positive then its an uppercase character;
! if negative then it's a lower case;
! if entry is zero then hack special( typically greek math strip);
integer array cw[0:17,0:127]; ! font-character width array;
integer tab_cnt,! number of tabs set in line. used as index in tab_buf;
last_col;! last column set. current minus this gives bell setting;
string array tab_buf[0:20]; ! contains string rep of point pica setting;
integer run_lngth; ! used to count line length based on chr.width and COL INC's;
boolean seen_bnd; ! used in optimizer: no bands → no change in width;
integer page1,
topar, ! break table for parens;
loc, ! index in punch buffer;
supfont,! index of superscript font;
subfont;! for subscripts;
real pix_pnt; ! 200/72;
integer array punch_buf[0:1000];
boolean mon, ! `minus on' when is sum-script mode;
sup, ! a superscript is in the line;
sub, ! a subscript appears;
uc; ! upper case flag;
! next variables are used to minimize the crap put on tape;
! removing unnecessary font, point size, and indent changes;
string cur_size; ! current point size;
integer cur_font_no; ! current font number;
integer cur_indent; ! current indentation;
boolean text_set; ! true if current line has text characters (non-bells);
! tty codes (yuk);
define bell='27,
eight='15,
zero='55,
eexx='72,
gee='64,
jay='26,
kay='36,
emm='70,
en='30,
comma='31,
period='71,
eff='32,
elll='44,
yyii='52,
you='16,
zee='42,
ensp='35,
bnd='10,
thin='1,
ql='33,
elev='04,
shift='66,
unshift='76,
supershift='45;
define flash='15,
noflash='61; ! these are for sumscripts( 8 and 9 in tty code)!;
define bellit=⊂begin
if not uc then stuff(bell)
else begin stuff(unshift);
stuff(bell);
uc←false;
end;
end⊃;
integer toppn; ! break table for ppn;
! define punch(x)=⊂wordout(ptpchan,x)⊃;
proc punch(integer x);
begin
if foo then outstr(vip[x]&crlf)else wordout(ptpchan,x);
end;
boolean procedure defile(integer chan; string file,ext,pj,pn); begin ! file defaults;
integer nam,ex,ppn; string sppn;
boolean flag;
nam←cvfil(file,ex,ppn); sppn←cvxstr(ppn);
sppn←"["&(if ppn lsh -18 then sppn[1 to 3] else pj)&","&
(if ppn land '777777 then sppn[4 to 6] else pn)&"]";
lookup(chan,(file←cvxstr(nam)&".")&cvxstr(ex)&sppn,flag);
if flag ∧ ex=0 then lookup(chan,file&ext&sppn,flag);
return(flag) ! TRUE if file not found;
end;
proc cw_init(string s;integer n);
begin "cw" string s1,file;integer i;boolean flag;
open(fontchan,"DSK",'14,2,0,0,0,eof);
s1←scan(s,toppn,i);
if length(s)=0 then file ← s1&".fnt[xgp,sys]"
else file ← s1&".fnt"&s;
lookup(fontchan,file,flag);
if flag then begin outstr("font not found");return;end;
for i←0 step 1 until 127 do
cw[n,i] ← wordin(fontchan) LSH -18;
if n=0 then begin "lead"
lead←wordin(fontchan); ! junk it;
lead←wordin(fontchan); ! get chr height;
end "lead";
release(fontchan);
end"cw";
proc cw_print(string s;integer n);
begin "cw" string s1,file;integer i,xx;boolean flag;
open(fontchan,"DSK",'14,2,0,0,0,eof);
s1←scan(s,toppn,i);
if length(s)=0 then file ← s1&".fnt[xgp,sys]"
else file ← s1&".fnt"&s;
lookup(fontchan,file,flag);
if flag then begin outstr("font not found");return;end;
outstr('14);
setformat(4,1);
outstr("chr widths for font "&file&crlf);
outstr(" octal chr decimal width"&crlf);
for i←0 step 1 until 127 do begin "printloop"
cw[n,i] ← wordin(fontchan) LSH -18;
if i≠0 ∧ i≠8 ∧ i ≠9
∧ i≠10 ∧ i ≠11
∧ i ≠'14 ∧ i ≠'15
then
outstr(" "&cvos(i)&" "&i&" "&cvs(64.8*cw[n,i])&crlf);
end "printloop";
if n=0 then begin "lead"
lead←wordin(fontchan); ! junk it;
lead←wordin(fontchan); ! get chr height;
end "lead";
release(fontchan);
end"cw";
! procedure typeset(string s);
forward proc setfont(integer n);
forward proc stuff(integer n);
forward proc tab_to(integer n);
forward proc typeset(string s);
forward proc special(string s);
proc typeset(string s);
begin "ty" integer s1;
debug(s&crlf);
while s ≠null do
begin "loop"
s1←lop(s);
if chrtbl[s1]>0 then begin
if uc then stuff(chrtbl[s1])
else begin stuff(shift);
stuff(chrtbl[s1]);
uc←true
end
end
else if chrtbl[s1]<0 then begin
if uc then begin stuff(unshift);
stuff(-chrtbl[s1]);
uc←false
end
else stuff(-chrtbl[s1])
end
else special(s1);
end "loop";
end "ty";
proc punch_num(string s);
begin "num" integer s1;
while s ≠null do
begin "loop"
s1←lop(s);
if chrtbl[s1]>0 then begin
outstr("bad pica-points for tab");
end
else if chrtbl[s1]<0 then begin
punch(-chrtbl[s1])
end
else outstr("bad pica-points for tab");
end "loop";
end"num";
proc tab_set(integer n);
begin "ty" integer i;string s;
i←1;
punch(bell);
punch(eexx);
while i<n do
begin "loop1"
s←tab_buf[i];
debug(s&crlf);
punch_num(s);
punch(bnd);
i←i+1;
end"loop1";
s←tab_buf[n];
debug(s&crlf);
punch_num(s);
punch(bell);
punch(yyii);
punch(bell);
punch(you);
end "ty";
define
grkss(n)=⊂begin
stuff(supershift);
stuff(n);
stuff(unshift);
uc←false;
end⊃,
grkuc(n)=⊂begin
if uc then stuff(n)
else begin stuff(shift);
stuff(n);
uc←true;
end;
end⊃,
grklc(n)=⊂begin
if not uc then stuff(n)
else begin stuff(unshift);
stuff(n);
uc←false
end;
end⊃;
proc special(string c); ! hack non-p45 character;
begin "sp"
integer n;
n←cur_font_no;
setfont(16);
if c="≤" then grkss('47)
else if c="<" then grkss('07) ! $;
else if c="=" then grklc('25) ! "4";
else if c="≥" then grkss('03) ! "3";
else if c=">" then grkss('73) ! "1";
else if c="{" then grkuc('25) ! "4";
else if c="}" then grkuc('41) ! "5";
else if c="≡" then grkss('15) ! "8";
else if c="+" then grklc('73) ! "1";
else if c="[" then grkuc('47) ! "2";
else if c="]" then grkuc('03) ! "3";
else if c="∞" then grklc('07) ! "$";
else if c="""" then grklc('55) ! "0";
else grkuc('56); ! "q";
setfont(n)
end "sp";
! character width stuff;
integer proc comp_lngth(string s);
begin "comp" integer n, s1;string s2;
! s2←s;
n←0;
while s≠null do
begin "loop"
s1←lop(s);
n←cw[cur_font_no,s1]+n;
end "loop";
! outstr("length of "&s2&" is"&cvs(n)&crlf);
! outstr("length of line is"&cvs(run_lngth)&crlf);
return(n);
end"comp";
proc stuff(integer x); ! x is tty code, jam it in punch buffer;
begin
debug("stuff"&cvos(x)&crlf);
punch_buf[loc]←x;
loc←loc+1;
end;
procedure film_adv(string s); ! s is string rep of point, half-point advance;
begin
punch(bell);
punch(eff);
setformat(-3,0);
punch_num(s);
end;
procedure line_meas(integer n); ! n is pixel width of page. punch it;
begin integer pt;
punch(bell);
punch(elll);
! outstr("⊗⊗*******"&cvs(n)&crlf);
pt←(n-offset)/pix_pnt;
! outstr("⊗⊗*******"&cvs(pt)&crlf);
setformat(-4,0);
punch_num(cvs((pt DIV 12)*100+(pt MOD 12)));
end;
proc indentto(integer n); ! manufacture the "bellIL" sequence;
! this should be optimized to kill the film advance;
begin "IN"
if n≠cur_indent then begin "chngind"
integer pt;
string s;
setformat(-4,0);
pt←(n-370.)/pix_pnt;
s←cvs((pt DIV 12)*100+(pt MOD 12));
if text_set then begin
stuff(ql);
bellit;
typeset("m"&slead&",");
end;
bellit;
typeset("il"&s);
cur_indent←n
end "chngind"
end "IN";
proc tab_to(integer n); ! manufacture the guts of the bell X-Y;
! sequence;
begin "IN"
integer pt,m;
string s;
if n=offset then begin last_col←n;return;end;
setformat(-4,0);
m←(n-last_col);
last_col←n;
pt←m/pix_pnt;
s←cvs((pt DIV 12)*100+(pt MOD 12));
debug("tab is "&cvs(n)&";output is "&s&crlf);
if equ(s,"0000") then s←"0001";
tab_cnt←tab_cnt+1;
tab_buf[tab_cnt]←s;
if text_set then stuff(elev) else
begin
stuff(ql);
stuff(elev);
end;
end "IN";
! proc setfont(integer n);
! crap to handle superscript and subscripts using flash-noflash hack.
when a sumscript is first recognized in line building,
(at font change) the bell sequence is made but with -1 or -2
at tthe flash position, the NEXT font change is recognized also
and a flash sequence is built with -3. at the end of the line
"setline" recognizes that sumscripts have been seen and "burp"s
the appropriate vversions of the line with correct leading
and appropriate substitutions of 8 and 9 for -1, -2, and -3;
define supon=-1,
subon=-2,
texton=-3;
proc setfont(integer n);
begin "SF"
if fontsize[n]≠cur_size then begin
bellit;
typeset("p"&(cur_size←fontsize[n]))
end;
if n≠cur_font_no then begin "curfnt"
bellit;
typeset(font[n]);
if n=supfont then begin
bellit;
stuff(supon);
sup←mon←true;
end
else if n=subfont then begin
bellit;
stuff(subon);
sub←mon←true;
end
else if mon then begin
bellit;
stuff(texton);
mon←false
end;
cur_font_no←n;
end "curfnt";
end "SF";
! proc setfootfont(integer n);
! version of setfont which works on footnotes ;
! crap to handle superscript and subscripts using flash-noflash hack.
when a sumscript is first recognized in line building,
(at font change) the bell sequence is made but with -1 or -2
at tthe flash position, the NEXT font change is recognized also
and a flash sequence is built with -3. at the end of the line
"setline" recognizes that sumscripts have been seen and "burp"s
the appropriate vversions of the line with correct leading
and appropriate substitutions of 8 and 9 for -1, -2, and -3;
proc setfootfont(integer n);
begin "SF" integer xx;
xx←fontsize[n];
if xx=10 then xx ← 8;
if xx≠cur_size then begin
bellit;
typeset("p"&(cur_size←xx))
end;
if n≠cur_font_no then begin "curfnt"
bellit;
typeset(font[n]);
if n=supfont then begin
bellit;
stuff(supon);
sup←mon←true;
end
else if n=subfont then begin
bellit;
stuff(subon);
sub←mon←true;
end
else if mon then begin
bellit;
stuff(texton);
mon←false
end;
cur_font_no←n;
end "curfnt";
end "SF";
! proc burp( reference integer array p: integer sup1, sub1, text);
! burp will dump line using flash/no flash crap;
proc burp( reference integer array p; integer sup1, sub1, text);
begin "b" integer i;
! if tab_cnt>0 then tab_set(tab_cnt);
if sup or sub then begin punch(bell);
punch(text)
end;
for i←0 step 1 until loc-1 do
begin "loop"
if p[i]=supon then punch(sup1)
else if p[i]=subon then punch(sub1)
else if p[i]=texton then punch(text)
else punch(p[i]);
end "loop";
punch(elev)
end "b";
! proc punch_sum(string s);
proc punch_sum(string s);
begin "sum"
setformat(-3,0);
if tab_cnt>0 then begin
punch(bell);
punch(zee);
punch(bell);
punch(emm);
punch_num(s);
punch(comma);
punch(bell);
punch(you)
end
else begin
punch(bell);
punch(emm);
punch_num(s);
punch(comma);
end;
end"sum";
! procedure setline; ! end of line routine. must check for sup/sub hacking;
! setline dumps line to punch, it will check sum scripts;
procedure setline; ! end of line routine. must check for sup/sub hacking;
begin "SL"
debug("run_lngth is"&cvs(run_lngth)&crlf);
debug("pwidth is"&cvs(pwidth)&crlf);
if uc then begin stuff(unshift);uc←false; end;
if run_lngth≠pwidth ∧ run_lngth≠0 then begin
line_meas(run_lngth);
pwidth←run_lngth;
seen_bnd←false;
end;
run_lngth←0;
if tab_cnt>0 then begin tab_to(pwidth);
loc←loc-1;
tab_set(tab_cnt);
end;
if sup then begin
punch_sum("040");! should compute this on basis of font size;
burp(punch_buf,
flash,
noflash,
noflash);
punch_sum("080"); ! should compute this on basis of font size!;
end;
burp(punch_buf,
noflash,
noflash,
flash);
if sub then begin
punch_sum("100");
burp(punch_buf,
noflash,
flash,
noflash);
loc←0;
punch_sum("020"); ! should compute this on basis of font size!;
punch(bell);
punch(eight);
end
else loc←0;
sub←sup←false;
text_set←false;
if tab_cnt>0 then begin punch(bell);
punch(zee);
end;
tab_cnt←0;
last_col←0; ! *********!!!!;
end "SL";
! procedure setfootline; ! end of line routine. must check for sup/sub hacking;
! setline dumps line to punch, it will check sum scripts;
procedure setfootline; ! end of line routine. must check for sup/sub hacking;
begin "SL"
debug("run_lngth is"&cvs(run_lngth)&crlf);
debug("pwidth is"&cvs(pwidth)&crlf);
if uc then begin stuff(unshift);uc←false; end;
if run_lngth≠pwidth ∧ run_lngth≠0 then begin
line_meas(run_lngth);
pwidth←run_lngth;
seen_bnd←false;
end;
run_lngth←0;
if tab_cnt>0 then begin tab_to(pwidth);
loc←loc-1;
tab_set(tab_cnt);
end;
if sup then begin
punch_sum("040");! should compute this on basis of font size;
burp(punch_buf,
flash,
noflash,
noflash);
punch_sum("080"); ! should compute this on basis of font size!;
end;
burp(punch_buf,
noflash,
noflash,
flash);
if sub then begin
punch_sum("100");
burp(punch_buf,
noflash,
flash,
noflash);
loc←0;
punch_sum("020"); ! should compute this on basis of font size!;
punch(bell);
punch(eight);
end
else loc←0;
sub←sup←false;
text_set←false;
if tab_cnt>0 then begin punch(bell);
punch(zee);
end;
tab_cnt←0;
last_col←0; ! *********!!!!;
end "SL";
! proc linesp(integer n);
! linesp figures the leading to give non-standard interline spacing;
proc linesp(integer n);
begin "LS"
integer m;
m←abs((xline-n)/(pix_pnt/2.0));
if m≠0 then begin
string s,s1;
setformat(-3,0);
s←cvs(m MOD 2);
s1←lop(s);
! bellit;
! typeset("m"&cvs((m DIV 2)*10+(m MOD 2))&(if xline>n then ","else "."));
! geezus, is that ugly!!!;
punch(bell);
punch(emm);
punch_num(cvs((m DIV 2)*10+(m MOD 2)));
punch(if xline>n then comma else period);
end;
end "LS";
procedure set_foot;
! set footnotes 8/10 in uncounted format;
! footnote is recognized as (at least) "____" and runs till "<FF>" ;
! will recognize multiple footnotes ;
! does NO hyphenation ;
begin "proc"
string s;
punch(bell);punch(en); ! now make uncounted tape for footnote;
film_adv("100");
while not eof do
BEGIN "SET foot"
s←input(inchan,tolb);
if length(s)≠0 then begin
typeset(s);
text_set←true;
end;
s←input(inchan,torb);
debug(" "&s&crlf);
if equ(s,"SP") then begin "foo1"
stuff(thin); ! *********stuff(ensp);
end "foo1"
else if equ(s,"CR") then continue
else if equ(s,"LF") then continue
else if equ(s,"LB")then begin
typeset("<");
end
else if equ(s,"RB")then begin
typeset(">");
end
else if equ(s,"FF") then begin "foo"
page←page+1;
setfootline;
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(bell);punch(jay); ! ⊗⊗⊗⊗⊗⊗******;
film_adv("120"); ! ************;
done end "foo"
else begin "BIGcommand"
string s1;
integer br;
s1←scan(s,tospeq,br);
if length(s)=0 then begin outstr("FOO on "&s1&crlf);continue end;
if equ(s1,"COLUMN") then begin
tab_to(cvd(s));
text_set←false;
end
else if equ(s1,"FONT") then setfootfont(cvd(s))
else if equ(s1,"LINESPACE") then begin linesp(cvd(s));
setfootline;
end
else if equ(s1,"COL") then begin "col inc"
stuff(bnd);
s1←scan(s,tospeq,br); ! flush "INC";
seen_bnd←true;
end "col inc"
else outstr("unrecognized command: "&s1&crlf);
end "BIGcommand";
end "SET foot";
end "proc";
begin "MAIN PROGRAM"
setbreak(topar←getbreak, "()", null, "INS");
setbreak(tospeq←getbreak, " =", null, "INS");
setbreak(toppn←getbreak, "[", null, "INR");
setbreak(todot←getbreak, ".",null, "INS");
setbreak(tocolon←getbreak, ":", null,"INS");
while true do
begin "IN"
outstr("name.ext (n:m)? (n≥2; always uses page 1)
");
open (inchan,"DSK",0,2,0,200,0,eof);
open (ptpchan, "PTP", '10,0,2,0,0,0);
! initialize some crap;
seen_bnd←true; ! initialized true to force initial line length;
run_lngth←0;
pwidth ← -1;
uc ← false;
loc←0;
cur_size←null;
cur_font_no←-1;
cur_indent←-1;
text_set←false;
tab_cnt←0;
last_col←0; ! *************;
offset←351;
pix_pnt←(200.0/72.0)*(30.0/29.0); ! holy shit!!!!!!!;
while true do
begin "file"
string file;
outstr("*");
S← inchwl;
ext ←scan(s,topar,i);
file←scan(ext,todot,i);
if length(ext)=0 then ext←"TYP";
s1←cvxstr(call(0,"dskppn"));
if defile(inchan,file,ext,s1[1 to 3],s1[4 to 6])
then outstr("FILE NOT FOUND: "&file&crlf)
else done;
end "file";
outstr("output to tty? yes → tty; no→ punch.(y/n)?"&crlf);
s1←inchwl;
if s1="y" or s1="Y" then foo ←true else foo←false;
comment add crap for page number location (suck for "<FF>");
if s=null then begin
pagebeg←2;
pagend←7000;
end
else begin
pagebeg←cvd(scan(s,tocolon,i));
if s="*" then pagend←7000
else pagend←cvd(s);
end;
comment read page 1;
BEGIN "PAGE1"
setbreak(page1←getbreak,"/<>=#",crlfff,"INS");
s1←input(inchan,page1); ! flush leading cr-lf and "/";
if length(s1)≠0
then begin
outstr(cvs(length(s1))&" not proper file format"&crlf);done
end;
s1←input(inchan,page1); ! snarf "lmar=";
lmar←cvd(input(inchan,page1)); ! save left margin setting;
s1←input(inchan,page1); ! snarf "xline=";
xline←cvd(input(inchan,page1)); ! save leading;
while true do
begin "FONTS"
integer f;
string name,s3,s4,f1;
if equ(input(inchan,page1), "CR") ! scan to"#" to get to font number;
then done;
f←cvd(f1 ← input(inchan,page1));! get font number;
name ← input(inchan,page1); ! get sail font name;
cw_print(name,f); ! get chr widths of name and stuff in cw[f,0:127];
cw_init(name,f); ! get chr widths of name and stuff in cw[f,0:127];
if font[f]=null then begin "ask font"
outstr("font "&f1&" is "&name&crlf);
outstr("give VIP position and point size (a-c&1-6&(1-99))
*");
s3←inchwl;
s4←scan(s3,topar,i);
font[f]←s4;
s4←scan(s3,topar,i);
fontsize[f]←s4;
end "ask font";
if equ(name,"SUB") then subfont←f
else if equ(name,"SUP") then supfont←f;
end "FONTS";
font[16]←"a3"; ! vip position for greek math;
fontsize[16]←"10"; ! point size;
! outstr("linelength in picas and points (aaoo)?"&crlf&"*");
width ← cvd(swidth←"4000");
pwidth←pix_pnt*12.*(width/100.);
! outstr("standard leading (points and half-points (ooh)?"&crlf&"*");
! lead ← cvd(slead←inchwl);
lead ← (lead+xline)/(pix_pnt/2.0);
slead← cvs((lead DIV 2)*10+(lead MOD 2)); ! lead set in cw_init;
END "PAGE1";
outstr("end of fonts");
page←inchwl;
page←2;
input(inchan,page1); ! snarf "<";
input(inchan,page1); ! snarf "LF>";
input(inchan,page1); ! snarf "<";
input(inchan,page1); ! snarf "FF>";
film_adv(slead); ! punch film advance;
line_meas(pwidth); ! punch line page width;
punch(bell);
punch(jay); ! do it in justified mode;
punch(bell);punch(gee); ! no hypenation;
punch(bell);punch(kay); punch(zero); ! no letterspacing;
setbreak(tolb←getbreak,"<",crlfffsp,"INS");
setbreak(torb←getbreak,">",crlfff,"INS");
while page≠pagebeg do
begin "suck"
s←input(inchan,tolb);
s←input(inchan,torb);
if equ(s,"FF") then page←page+1;
end"suck";
while page ≤pagend and not eof do
BEGIN "SET TEXT"
while not eof do
BEGIN "SET PAGE"
s←input(inchan,tolb);
if length(s)≠0 then begin
if equ(s[1 to 4], "____") then begin
set_foot;
continue
end
else begin
run_lngth←run_lngth+comp_lngth(s);
typeset(s);
text_set←true;
end;
end;
s←input(inchan,torb);
debug(" "&s&crlf);
if equ(s,"SP") then begin "foo1"
run_lngth←run_lngth+comp_lngth(" ");
stuff(thin); ! *********stuff(ensp);
end "foo1"
else if equ(s,"CR") then setline
else if equ(s,"LF") then continue
else if equ(s,"LB")then begin
run_lngth←run_lngth+comp_lngth("<");
typeset("<");
end
else if equ(s,"RB")then begin
run_lngth←run_lngth+comp_lngth(">");
typeset(">");
end
else if equ(s,"FF") then begin "foo"
page←page+1;
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
punch(QL);punch(elev);
done end "foo"
else begin "BIGcommand"
string s1;
integer br;
s1←scan(s,tospeq,br);
if length(s)=0 then begin outstr("FOO on "&s1&crlf);continue end;
if equ(s1,"COLUMN") then begin
tab_to(cvd(s));
text_set←false;
run_lngth←cvd(s)
end
else if equ(s1,"FONT") then setfont(cvd(s))
else if equ(s1,"LINESPACE") then linesp(cvd(s))
else if equ(s1,"COL") then begin "col inc"
stuff(bnd);
s1←scan(s,tospeq,br); ! flush "INC";
run_lngth←run_lngth+cvd(s);
seen_bnd←true;
end "col inc"
else outstr("unrecognized command: "&s1&crlf);
end "BIGcommand";
end "SET PAGE";
end "SET TEXT";
bellit;
typeset("s");
setline
end "IN";
end "MAIN PROGRAM";
end "TYPESET"